home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / lib / misc / gdbm.c < prev    next >
C/C++ Source or Header  |  1992-10-21  |  7KB  |  252 lines
  1. /* Elk/GDBM-interface.
  2.  *
  3.  * Original version by Martin Stut <stut@informatik.tu-muenchen.dbp.de>.
  4.  *
  5.  * Functions exported:
  6.  *
  7.  * (gdbm-file? obj)
  8.  *
  9.  *   Type predicate for the newly defined type gdbm-file.
  10.  *
  11.  * (gdbm-open filename block-size type [filemode])
  12.  *
  13.  *   Opens a gdbm file and returns an object of type gdbm-file.
  14.  *   Returns #f if file cannot be opened.
  15.  *   filename is a string or a symbol, block-size is an integer,
  16.  *   type is one of the symbols 'reader, 'writer, 'create, and 'new,
  17.  *   the optional file mode is an integer (default: #o644).
  18.  *
  19.  * (gdbm-close gf)
  20.  *
  21.  *   Closes a gdbm file.  Attempts to use a closed gdbm file as
  22.  *   an argument to any gdbm-function causes the error message
  23.  *   "invalid gdbm-file" to be displayed.
  24.  *
  25.  * (gdbm-store gf key data mode)
  26.  *
  27.  *   Stores an item in the gdbm file pointed to by gf.
  28.  *   key and data are strings, mode is a symbol (either 'insert
  29.  *   or 'replace).
  30.  *   Returns -1 if called by a reader, 1 if called with 'insert and
  31.  *   the key is already stored, 0 otherwise.
  32.  *
  33.  * (gdbm-fetch gf key)
  34.  *
  35.  *   Searches the gdbm file pointed to by gf for data stored under
  36.  *   the given key and returns the data as a string.
  37.  *   Returns #f if nothing is stored under that key.
  38.  *
  39.  * (gdbm-delete gf key)
  40.  *
  41.  *   Removes data stored under the specified key from the gdbm file gf.
  42.  *   Returns #f if the key is not present in the gdbm file, #t otherwise.
  43.  *
  44.  * (gdbm-firstkey gf)
  45.  * (gdbm-nextkey gf key)
  46.  *
  47.  *   These functions are used to access all items in a gdbm file.
  48.  *   Both return a key.  gdbm-firstkey returns #f if the gdbm file
  49.  *   is empty; gdbm-nextkey returns #f if there is no next key.
  50.  *
  51.  * (gdbm-reorganize gf)
  52.  *
  53.  *   Shortens the specified gdbm file (reclaims deleted space).
  54.  *
  55.  * (gdbm-error)
  56.  *
  57.  *   Returns a cons cell; the car is the last error number set by
  58.  *   the gdbm library, the cdr is the current UNIX errno.
  59.  *
  60.  * (gdbm-error-text)
  61.  *
  62.  *   Returns the last error message passed to the fatal error
  63.  *   function by the gdbm library (a string).
  64.  *
  65.  * Loading gdbm.o provides the symbol 'gdbm.
  66.  */
  67.  
  68.  
  69. #include "scheme.h"
  70. #include "../util/symbol.h"
  71. #include <gdbm.h>
  72. #include <errno.h>
  73.  
  74. extern gdbm_error gdbm_errno;
  75. extern int errno;
  76. static char *gdbm_error_message = "";
  77.  
  78. static SYMDESCR RW_Syms[] = {
  79.     { "reader", GDBM_READER },
  80.     { "writer", GDBM_WRITER },
  81.     { "create", GDBM_WRCREAT },
  82.     { "new",    GDBM_NEWDB },
  83.     { 0, 0 }
  84. };
  85.  
  86. static SYMDESCR Flag_Syms[] = {
  87.     { "insert",  GDBM_INSERT },
  88.     { "replace", GDBM_REPLACE },
  89.     { 0, 0 }
  90. };
  91.  
  92. int T_Gdbm_fh;
  93.  
  94. struct S_gdbm_fh{
  95.     Object tag;
  96.     GDBM_FILE fptr;
  97.     char free;
  98. };
  99.  
  100. #define GDBM_FH(obj) ((struct S_gdbm_fh *)POINTER(obj))
  101.  
  102. int Gdbm_fh_Equal (a, b) Object a, b; {
  103.     return !GDBM_FH(a)->free && !GDBM_FH(b)->free &&
  104.         GDBM_FH(a)->fptr == GDBM_FH(b)->fptr;
  105. }
  106.  
  107. /*ARGSUSED*/
  108. void Gdbm_fh_Print (fh, port, raw, depth, len) Object fh, port;
  109.     int /*Bool*/ raw; int depth, len; {
  110.     Printf (port, "#[gdbm-file %lu]", GDBM_FH(fh)->fptr);
  111. }
  112.  
  113. Object P_Gdbm_filep (x) Object x; {
  114.     return TYPE(x) == T_Gdbm_fh ? True : False;
  115. }
  116.  
  117. static void Fatal_Func (s) char *s; {
  118.     gdbm_error_message = s;
  119.     fprintf (stderr, "gdbm error: %s\n", s);
  120. }
  121.  
  122. Object P_Gdbm_Open (argc, argv) Object *argv; {
  123.     char *p;
  124.     Object Gdbm_fh;
  125.     GDBM_FILE dbf;
  126.     Declare_C_Strings;
  127.  
  128.     Make_C_String (argv[0], p);
  129.     dbf = gdbm_open (p, Get_Integer (argv[1]),
  130.     Symbols_To_Bits (argv[2], 0, RW_Syms),
  131.     argc == 4 ? Get_Integer (argv[3]) : 0644, Fatal_Func);
  132.     if (dbf == 0)
  133.     return False;
  134.     Gdbm_fh = Alloc_Object (sizeof (struct S_gdbm_fh), T_Gdbm_fh, 0);
  135.     GDBM_FH (Gdbm_fh)->tag = Null;
  136.     GDBM_FH (Gdbm_fh)->fptr = dbf;
  137.     GDBM_FH (Gdbm_fh)->free = 0;
  138.     Dispose_C_Strings;
  139.     return Gdbm_fh;
  140. }
  141.  
  142. GDBM_FILE Check_Fh (fh) Object fh; {
  143.     Check_Type (fh, T_Gdbm_fh);
  144.     if (GDBM_FH(fh)->free)
  145.     Primitive_Error ("invalid gdbm-file: ~s", fh);
  146. }
  147.  
  148. Object P_Gdbm_Close (fh) Object fh; {
  149.     Check_Fh (fh);
  150.     GDBM_FH(fh)->free = 1;
  151.     gdbm_close (GDBM_FH(fh)->fptr);
  152.     return Void;
  153. }
  154.  
  155. Object P_Gdbm_Store (fh, key, content, flag)
  156.     Object fh, key, content, flag; {
  157.     int res;
  158.     datum k, c;
  159.  
  160.     Check_Fh (fh);
  161.     Check_Type (key, T_String);
  162.     Check_Type (content, T_String);
  163.     k.dptr = STRING(key)->data;
  164.     k.dsize = STRING(key)->size;
  165.     c.dptr = STRING(content)->data;
  166.     c.dsize = STRING(content)->size;
  167.     res = gdbm_store (GDBM_FH(fh)->fptr, k, c,
  168.     Symbols_To_Bits (flag, 0, Flag_Syms));
  169.     return Make_Integer (res);
  170. }
  171.  
  172. static Object Gdbm_Get (fh, key, func) Object fh, key; datum (*func)(); {
  173.     Object res;
  174.     datum k, c;
  175.  
  176.     Check_Fh (fh);
  177.     Check_Type (key, T_String);
  178.     k.dptr = STRING(key)->data;
  179.     k.dsize = STRING(key)->size;
  180.     c = (*func) (GDBM_FH(fh)->fptr, k);
  181.     if (c.dptr == 0)
  182.     return False;
  183.     res = Make_String (c.dptr, c.dsize);
  184.     free (c.dptr);
  185.     return res;
  186. }
  187.  
  188. Object P_Gdbm_Fetch (fh, key) Object fh, key; {
  189.     return Gdbm_Get (fh, key, gdbm_fetch);
  190. }
  191.  
  192. Object P_Gdbm_Nextkey (fh, key) Object fh, key; {
  193.     return Gdbm_Get (fh, key, gdbm_nextkey);
  194. }
  195.  
  196. Object P_Gdbm_Delete (fh, key) Object fh, key; {
  197.     int res;
  198.     datum k;
  199.  
  200.     Check_Fh (fh);
  201.     Check_Type (key, T_String);
  202.     k.dptr = STRING(key)->data;
  203.     k.dsize = STRING(key)->size;
  204.     res = gdbm_delete (GDBM_FH(fh)->fptr, k);
  205.     return res == 0 ? True : False;
  206. }
  207.  
  208. Object P_Gdbm_Firstkey (fh) Object fh; {
  209.     Object res;
  210.     datum k;
  211.  
  212.     Check_Fh (fh);
  213.     k = gdbm_firstkey (GDBM_FH(fh)->fptr);
  214.     if (k.dptr == 0) 
  215.     return False;
  216.     res = Make_String (k.dptr, k.dsize);
  217.     free (k.dptr);
  218.     return res;
  219. }
  220.  
  221. Object P_Gdbm_Reorganize (fh) Object fh; {
  222.     Check_Fh (fh);
  223.     gdbm_reorganize (GDBM_FH(fh)->fptr);
  224.     return Void;
  225. }
  226.  
  227. Object P_Gdbm_Error () {
  228.     return Cons (Make_Fixnum ((int)gdbm_errno), Make_Fixnum (errno));
  229. }
  230.  
  231. Object P_Gdbm_Error_Text () {
  232.     return Make_String (gdbm_error_message, strlen (gdbm_error_message));
  233. }
  234.  
  235. init_lib_gdbm () {
  236.     Define_Primitive (P_Gdbm_Open, "gdbm-open", 3, 4, VARARGS);
  237.     Define_Primitive (P_Gdbm_filep, "gdbm-file?", 1, 1, EVAL);
  238.     Define_Primitive (P_Gdbm_Close, "gdbm-close", 1, 1, EVAL);
  239.     Define_Primitive (P_Gdbm_Store, "gdbm-store", 4, 4, EVAL);
  240.     Define_Primitive (P_Gdbm_Fetch, "gdbm-fetch", 2, 2, EVAL);
  241.     Define_Primitive (P_Gdbm_Delete, "gdbm-delete", 2, 2, EVAL);
  242.     Define_Primitive (P_Gdbm_Firstkey, "gdbm-firstkey", 1, 1, EVAL);
  243.     Define_Primitive (P_Gdbm_Nextkey, "gdbm-nextkey", 2, 2, EVAL);
  244.     Define_Primitive (P_Gdbm_Reorganize, "gdbm-reorganize", 1, 1, EVAL);
  245.     Define_Primitive (P_Gdbm_Error, "gdbm-error", 0, 0, EVAL);
  246.     Define_Primitive (P_Gdbm_Error_Text, "gdbm-error-text", 0, 0, EVAL);
  247.     T_Gdbm_fh = Define_Type (0, "gdbm-file", NOFUNC,
  248.     sizeof (struct S_gdbm_fh), Gdbm_fh_Equal, Gdbm_fh_Equal,
  249.     Gdbm_fh_Print, NOFUNC);
  250.     P_Provide (Intern ("gdbm"));
  251. }
  252.